Series de tiempo y descomposición

Clase 02

Prerrequisitos

Se requiere tener instaladas y cargadas las siguientes paqueterías.

library(tidyverse)
library(tidyquant)
library(plotly)
library(tsibble)
library(readxl)
library(fpp3)

Algunas series de tiempo

Tipo de cambio USD/JPY

Cargamos los datos a R.

usd_jpy <- read_csv("USD_JPY.csv")

Missing column names filled in: 'X1' [1]Parsed with column specification:
cols(
  X1 = col_double(),
  TimeStamp = col_datetime(format = ""),
  Open = col_double(),
  High = col_double(),
  Low = col_double(),
  Close = col_double()
)

usd_jpy

Gráfica de tiempo

p <- usd_jpy %>% 
  ggplot(aes(x = TimeStamp, y = Close)) +
  geom_line()

ggplotly(p)

Gráfica de velas

p <- ggplot(data = usd_jpy, aes(x = TimeStamp, y = Close)) +
  geom_candlestick(aes(open = Open, high = High, low = Low, close = Close), colour_up = "darkgreen",colour_down = "red", size = 1)
p

p + coord_x_datetime(xlim = c("2019-07-01","2019-08-01"), 
                     ylim = c(106,109.5))

Horas que pasan los americanos durmiendo

Carga de los datos.

americans <- read_excel("Time Americans Spend Sleeping.xlsx")
americans

Gráfica por tipo de días

p <- americans %>% 
  filter(Sex == "Both") %>% 
  ggplot(aes(x = Year, `Avg hrs per day sleeping`, 
             color = `Age Group`)) +
  geom_line() + facet_wrap(~ `Type of Days`, nrow = 1)

ggplotly(p)

Gráfica por tipo de días y Sexo

p <- americans %>% 
  ggplot(aes(x = Year, `Avg hrs per day sleeping`, 
             color = `Age Group`)) +
  geom_line() + facet_grid(`Type of Days` ~ Sex)

ggplotly(p)

Ventas de autos

car_sales <- tq_get("TOTALNSA", get = "economic.data", from = "1977-01-01")
car_sales

Gráfica de tiempo

p <- car_sales %>% 
  ggplot(aes(x = date, y = price)) + 
  geom_line()

ggplotly(p)

Tipos de ajustes/transformaciones

Ajustes por población

Tomaremos la tabla global_economy y vamos a filtrarla para quedarnos con cuatro países y graficar el PIB y el PIB con escala logarítmica.

ge <- global_economy %>% 
  filter(Country %in% c("Mexico", "Iceland", "Australia", "Colombia"))

p3 <- ggplot(ge) + aes(x = Year, y = GDP, color = Country) + 
  geom_line(size = 1)

p3

Revisando la última población registrada de cada país.

ge %>% 
  filter(Year == 2017) %>% 
  arrange(desc(Population))

Vemos que existe una gran diferencia en la población de estos países. Para poder comparar el PIB entre ellos, sería mejor realizar un ajuste por población y revisar la variable PIB per cápita.

ge <- global_economy %>% 
  filter(Country %in% c("Australia", "Mexico", "Iceland", "Colombia"))

p4 <- ggplot(ge) + aes(x = Year, y = GDP / Population, color = Country) +
  geom_line(size = 1) + ylab("GDP per capita")

p4

Transformaciones matemáticas

Comúnmente se podrán llevar a cabo transformaciones logarítmicas.

p3 + scale_y_log10()

Ajustes por inflación

Tomaremos la tabla precargada aus_retail y seleccionaremos la industria de impresión. Resumiremos los datos de manera anual y compararemos las gráficas de la serie en precios corrientes y ajustados por inflación (o a precios constantes).

print_retail <- aus_retail %>%
  filter(Industry == "Newspaper and book retailing") %>%
  group_by(Industry) %>%
  index_by(Year = year(Month)) %>%
  summarise(Turnover = sum(Turnover))
aus_economy <- global_economy %>%
  filter(Code == "AUS")
print_retail %>%
  left_join(aus_economy, by = "Year") %>%
  mutate(Adjusted_turnover = Turnover / CPI) %>%
  gather("Type", "Turnover", Turnover, Adjusted_turnover, factor_key = TRUE) %>%
  ggplot(aes(x = Year, y = Turnover)) +
    geom_line() +
    facet_grid(vars(Type), scales = "free_y") +
    xlab("Years") + ylab(NULL) +
    ggtitle("Turnover for the Australian print media industry")

El ecosistema tidyverts

Estas paqueterías son parte del tidyverts y utilizan la misma filosofía del tidyverse, pero se especializan en el análisis de series de tiempo.

library(tsibble)
library(feasts)
library(fable)

Transformaciones de Box-Cox

Otra familia de transformaciones, que depende de un parámetro \(\lambda\) para escoger el tipo de transformación a realizar. Para ejemplificarlo, tomamos los datos precargados aus_production.

aus_production

Graficar la producción de gas.

aus_production %>% autoplot(Gas)

Queremos estabilizar la varianza y una transformación logarítmica (o Box-Cox con \(\lambda = 0\)) parece no ser suficiente:

aus_production %>% autoplot(log(Gas))

There were 20 warnings (use warnings() to see them)

Obtenemos la característica de Guerrero para decidir el valor óptimo de \(\lambda\).

(lambda <- aus_production %>%
  features(Gas, features = guerrero) %>%
  pull(lambda_guerrero))

[1] 0.1204864

Podemos aplicar la transformación directo en el autoplot.

aus_production %>% autoplot(box_cox(Gas, lambda))

Descomposición de series de tiempo

us_retail_employment <- us_employment %>%
  filter(year(Month) >= 1990, Title == "Retail Trade") %>%
  select(-Series_ID)

us_retail_employment

us_retail_employment %>%
  autoplot(Employed) +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail")

dcmp <- us_retail_employment %>%
  model(STL(Employed))

components(dcmp)

us_retail_employment %>%
  autoplot(Employed, color='gray') +
  autolayer(components(dcmp), trend, color='red') +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail")

components(dcmp) %>% autoplot() + xlab("Year")

us_retail_employment %>%
  autoplot(Employed, color='gray') +
  autolayer(components(dcmp), season_adjust, color='blue') +
  xlab("Year") + ylab("Persons (thousands)") +
  ggtitle("Total employment in US retail")

Descomposición clásica

us_retail_employment %>%
  model(classical_decomposition(Employed, type = "additive")) %>%
  components() %>%
  autoplot() + xlab("Year") +
  ggtitle("Classical additive decomposition of total US retail employment")

Descomposición X11

x11_dcmp <- us_retail_employment %>%
  model(x11 = feasts:::X11(Employed, type = "additive")) %>%
  components()

autoplot(x11_dcmp) + xlab("Year") +
  ggtitle("Additive X11 decomposition of US retail employment in the US")

x11_dcmp %>% 
  gg_season()

Plot variable not specified, automatically selected `y = Employed`

x11_dcmp %>% 
  gg_subseries(seasonal)

Descomposición SEATS

seats_dcmp <- us_retail_employment %>%
  model(seats = feasts:::SEATS(Employed)) %>%
  components()
autoplot(seats_dcmp) + xlab("Year") +
  ggtitle("SEATS decomposition of total US retail employment")

Descomposición STL

us_retail_employment %>%
  model(STL(Employed ~ trend(window=7) + season(window = "periodic"),
    robust = TRUE)) %>%
  components() %>%
  autoplot()

usd_ts <- usd_jpy %>%
  as_tsibble(index = TimeStamp) %>% 
  fill_gaps() %>% fill(Close)

usd_ts %>% 
  model(STL(Close)) %>% 
  components() %>% autoplot()

ge %>% 
  model(STL(log(GDP))) %>% 
  components() %>% 
  autoplot()